(require* sketch/parse/rule/util)

(defrule openarrowhead-line
    "open-arrow-head = line, line, line"
    ?fs <- (shape (name "Line") (obj ?shaft))
    ?f1 <- (shape (name "Line") (obj ?s1&~?shaft))
    ?f2 <- (shape (name "Line") (obj ?s2&~?s1&~?shaft))
	(test (call ShapePredicate joinsLineLine ?shaft ?s1))
    (test (call ShapePredicate joinsLineLine ?shaft ?s2))
    (test (call ShapePredicate joinsLineLine ?s1 ?s2))
    (test (call ShapePredicate nearPointPoint
          	(?shaft getCommonPointTo ?s1)
          	(?shaft getCommonPointTo ?s2)))
    (test (call ShapePredicate acuteAngleDLineLine
            (?shaft getLineStartWith (?shaft getCommonPointTo ?s1))
            (?s1 getLineStartWith (?s1 getCommonPointTo ?shaft))))
    (test (call ShapePredicate acuteAngleDLineLine
            (?s2 getLineStartWith (?shaft getCommonPointTo ?s2))
            (?shaft getLineStartWith (?s2 getCommonPointTo ?shaft))))
    (test (call ShapePredicate equalLengthLineLine ?s1 ?s2))
    (test (call ShapePredicate equalAngle
            (?shaft angleWith ?s1)
            (?s2 angleWith ?shaft)))
    =>
    (printout "recognize open-arrow-head = line, line, line")
    (bind ?sh (new OpenArrowHead))
    (?sh setHead (?shaft getCommonPointTo ?s1))
    (?sh setTail (?shaft getEndPointTo ?s1))
    (?sh setAngle (?shaft angleWith ?s1))
    (?sh setLength (?s1 length))

    (bind ?shl (new Line))
    (?shl setP1 (?shaft getCenter))
    (?shl setP2 (?sh getTail))
    (?sh setTail (?shaft getCenter))

    (retract ?fs)
    (retract ?f1)
    (retract ?f2)

    (assert (shape
            (name "OpenArrowHead")
            (obj ?sh)
            (children ?shaft ?s1 ?s2)))
    (recognize ?sh (list-children (create$ ?s1 ?s2 ?shaft)))
    (assert (shape
            (name "Line")
            (obj ?shl)
            (children ?shaft)))
    (recognize ?shl (list-children (create$ ?shaft))))

